Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/graphics/bitlin/main.frm

Visual Basic Form | 1995-05-23 | 28.7 KB | 791 lines

VERSION 2.00
Begin Form frmMain
   BackColor       =   &H00FFFFFF&
   Height          =   5400
   Icon            =   MAIN.FRX:0000
   Left            =   1125
   LinkTopic       =   "Form2"
   ScaleHeight     =   4710
   ScaleWidth      =   4260
   Top             =   1020
   Width           =   4380
   Begin PictureBox picTemp
      AutoRedraw      =   -1  'True
      BorderStyle     =   0  '
      Height          =   735
      Left            =   360
      ScaleHeight     =   735
      ScaleWidth      =   3975
      TabIndex        =   7
      Top             =   840
      Visible         =   0   'False
      Width           =   3975
   End
   Begin ODListBox ODLSample
      Height          =   2535
      HelpContextID   =   3002
      HScroll         =   0   'False
      IconIdxArray    =   0   'False
      ItemBackColor   =   &H00000000&
      ItemHeight      =   0
      Left            =   0
      MultiSelect     =   0  '
      Sort            =   0   'False
      Sorted          =   0   'False
      TabIndex        =   6
      Top             =   480
      Width           =   2175
   End
   Begin PictureBox PicControl
      Align           =   1  '
      BackColor       =   &H00C0C0C0&
      FillColor       =   &H00FFFFFF&
      Height          =   495
      HelpContextID   =   3002
      Left            =   0
      ScaleHeight     =   465
      ScaleWidth      =   4230
      TabIndex        =   0
      Top             =   0
      Width           =   4260
      Begin TextBox txtHeight
         Height          =   285
         Left            =   1095
         TabIndex        =   3
         Text            =   "34"
         Top             =   75
         Width           =   615
      End
      Begin Image ImgRight2
         Height          =   375
         Left            =   6600
         Picture         =   MAIN.FRX:0302
         Top             =   120
         Visible         =   0   'False
         Width           =   360
      End
      Begin Image ImgRight1
         Height          =   375
         Left            =   6000
         Picture         =   MAIN.FRX:04A8
         Top             =   120
         Visible         =   0   'False
         Width           =   360
      End
      Begin Image Imgleft2
         Height          =   375
         Left            =   5640
         Picture         =   MAIN.FRX:064E
         Top             =   120
         Visible         =   0   'False
         Width           =   360
      End
      Begin Image Imgleft1
         Height          =   375
         Left            =   5160
         Picture         =   MAIN.FRX:07F4
         Top             =   120
         Visible         =   0   'False
         Width           =   360
      End
      Begin Image Imgsave1
         Height          =   330
         Left            =   4320
         Picture         =   MAIN.FRX:099A
         Top             =   120
         Visible         =   0   'False
         Width           =   375
      End
      Begin Image Imgsave2
         Height          =   330
         Left            =   4680
         Picture         =   MAIN.FRX:0B74
         Top             =   120
         Visible         =   0   'False
         Width           =   345
      End
      Begin Image imgRight
         Height          =   330
         Left            =   2865
         Picture         =   MAIN.FRX:0CF6
         Stretch         =   -1  'True
         Top             =   75
         Width           =   375
      End
      Begin Image imgLeft
         Height          =   330
         Left            =   2445
         Picture         =   MAIN.FRX:0E9C
         Stretch         =   -1  'True
         Top             =   75
         Width           =   375
      End
      Begin Image imgSave
         Height          =   330
         Left            =   1920
         Picture         =   MAIN.FRX:1042
         Stretch         =   -1  'True
         Top             =   75
         Width           =   375
      End
      Begin Label lblHeight
         BackColor       =   &H00C0C0C0&
         Caption         =   "Item Height:"
         Height          =   255
         Left            =   120
         TabIndex        =   2
         Top             =   120
         Width           =   975
      End
   End
   Begin PictureBox picStatus
      Align           =   2  '
      BackColor       =   &H00C0C0C0&
      Height          =   1095
      Left            =   0
      ScaleHeight     =   1065
      ScaleWidth      =   4230
      TabIndex        =   1
      Top             =   3615
      Width           =   4260
      Begin TextBox txtBitName
         BackColor       =   &H00FFFFFF&
         Height          =   285
         HelpContextID   =   3002
         Index           =   0
         Left            =   120
         TabIndex        =   5
         Top             =   45
         Width           =   645
      End
      Begin PictureBox picBitmaps
         BorderStyle     =   0  '
         Height          =   615
         HelpContextID   =   7000
         Index           =   0
         Left            =   120
         ScaleHeight     =   615
         ScaleWidth      =   615
         TabIndex        =   4
         Top             =   360
         Width           =   615
      End
      Begin Image ImgBitmaps
         Height          =   495
         Index           =   0
         Left            =   120
         Stretch         =   -1  'True
         Top             =   360
         Width           =   735
      End
   End
   Begin Menu mnuFile
      Caption         =   "&File"
      HelpContextID   =   6000
      Begin Menu mnuNew
         Caption         =   "&New"
      End
      Begin Menu mnuOpen
         Caption         =   "&Open"
      End
      Begin Menu mnuSave
         Caption         =   "&Save"
      End
      Begin Menu mnuSaveAs
         Caption         =   "Save&As"
      End
      Begin Menu mnuSep2
         Caption         =   "-"
      End
      Begin Menu mnuExit
         Caption         =   "E&xit"
      End
   End
   Begin Menu mnuEdit
      Caption         =   "&Edit"
      HelpContextID   =   7000
      Begin Menu mnuInsert
         Caption         =   "&Insert"
      End
      Begin Menu mnuAppend
         Caption         =   "&Append"
      End
      Begin Menu menSep3
         Caption         =   "-"
      End
      Begin Menu mnuBMPFile
         Caption         =   "&BMPFile"
      End
      Begin Menu mnuSep4
         Caption         =   "-"
      End
      Begin Menu mnuCopy
         Caption         =   "&Copy"
      End
      Begin Menu mnuPaste
         Caption         =   "&Paste"
      End
      Begin Menu mnuClear
         Caption         =   "C&lear"
      End
      Begin Menu mnuDelete
         Caption         =   "&Delete"
      End
   End
   Begin Menu mnuView
      Caption         =   "&View"
      HelpContextID   =   3002
      Begin Menu mnuSample
         Caption         =   "&Show sample"
      End
   End
   Begin Menu mnuHelp
      Caption         =   "&Help"
      Begin Menu mnuContents
         Caption         =   "&Contents"
      End
      Begin Menu mnuSearch
         Caption         =   "&Search for Help on..."
      End
      Begin Menu mnuHowto
         Caption         =   "&How to use Help"
      End
      Begin Menu mnuAbout
         Caption         =   "&About"
      End
   End
'Option Explicit
Dim cntBitmaps              'number of bitmaps images
Dim selBitmap               'index of selected bitmap, -1 if none selected
Dim MouseButton
Dim startp() As Integer     'starting position of items in ODList
Dim fname As String         'file name
Sub displayBMP (Index As Integer)
'Display BMP image in Bitmap image box
'  Bitmap image is displayed in imgBitmaps()
'  PicBitmaps() is hidden (empty box)
'Insert full path
procInsPath
'Display picture
imgBitmaps(Index).Picture = LoadPicture(frmGetFile.Tag)
picBitmaps(Index).Visible = False
End Sub
'Copyright 1995 by Hitoshi Ozawa
Sub Form_Activate ()
'Set main form caption
If fname = "" Then                         'if no file name than
 frmMain.Caption = "Bitmap Image Liner"       'set main form caption as Bitmap Image Liner
Else                                       'If there is a file - ie. it was saved once
 frmMain.Caption = fname                       'set main form caption as name of a file
End If
End Sub
'Copyright 1995 by Hitoshi Ozawa
Sub Form_Load ()
'Set Help file name
HelpFileName = App.Path
If Right$(App.Path, 1) <> "\" Then
 HelpFileName = HelpFileName + "\"
End If
HelpFileName = HelpFileName + "bitlin.hlp"
App.HelpFile = HelpFileName
'Show Tao cursor while in LHA operation
retcode = LhaSetCursorMode(1)
'Set size of buffer to use in LHA.DLL
szbuff = 4052
'Set which form is currently being displayed
curForm = fMain
' Load the frmGetFile dialog box without displaying
Load frmGetFile
'Initialize the cboFileType combo box of the frmGetFile
frmGetFile.cboFileType.AddItem "Text files (*.BMP)"   'Add BMP as first pattern
frmGetFile.cboFileType.AddItem "All files (*.*)"      'All files as second
frmGetFile.cboFileType.AddItem "LHA files (*.LZH)"    'LZH files as third
frmGetFile.cboFileType.ListIndex = 0                  'Default file pattern to 1st pattern(ie. BMP)
'Initialization
cntBitmaps = 1      'Number of bitmaps
selBitmap = -1      'Currently selected bitmap image (-1 = no selection)
'Set height of bitmap images
txtHeight_LostFocus
End Sub
'Copyright 1995 by Hitoshi Ozawa
Sub Form_resize ()
'Be sure that all bitmap images are displayed on screen
'Is the last bitmap location + width of bitmap greater than width of a form
'  ie. if lined bitmap image going past the main form?
If (picBitmaps(cntBitmaps - 1).Left + picBitmaps(0).Width) > frmMain.Width Then
  frmMain.Width = picBitmaps(cntBitmaps - 1).Left + picBitmaps(cntBitmaps - 1).Width * 1.5
End If
'Is the height of bitmaps sufficient?
If (frmMain.ScaleHeight - picControl.ScaleHeight - picStatus.ScaleHeight) < (Val(txtHeight.Text) * screen.TwipsPerPixelY) Then
 frmMain.Height = frmMain.ScaleHeight + picControl.ScaleHeight + picStatus.ScaleHeight
End If
'Set the width of the control box (Item Height and arrow buttons)
picControl.ScaleWidth = frmMain.ScaleWidth
'Readjust ODList box width and height
ODLSample.Width = frmMain.ScaleWidth
ODLSample.Height = frmMain.ScaleHeight - picControl.ScaleHeight - picStatus.ScaleHeight
End Sub
'Copyright 1995 by Hitoshi Ozawa
Sub ImgBitmaps_Click (Index As Integer)
'Bitmap image was selected - ie. bitmap image box with a picture was selected
If imgBitmaps(Index).BorderStyle = 1 Then    'If the selected bitmap box is already selected, then unselect it
 imgBitmaps(Index).BorderStyle = 0              'turn borders of both image and picture box to 0 - no borders
 picBitmaps(Index).BorderStyle = 0
 txtBitName(Index).BackColor = RGB(256, 256, 256)   'set color of corresponding item name box to white
 selBitmap = -1                                     'set selected bitmap box to none
Else                                          'If the currently selected bitmap is not selected
 If selBitmap > -1 Then                          'check if other bitmap box is currently selected
  imgBitmaps(selBitmap).BorderStyle = 0            'if some other box is selected, unselect it
  picBitmaps(selBitmap).BorderStyle = 0              'turn border off
  txtBitName(selBitmap).BackColor = RGB(256, 256, 256)    'set color of corresponding item name box to white
 End If
 imgBitmaps(Index).BorderStyle = 1                 'Set the selected bitmap box as selected
 picBitmaps(Index).BorderStyle = 1                 'change border to a line
 txtBitName(Index).BackColor = RGB(160, 240, 120)  'change color of corresponding item name box
 selBitmap = Index                                 'set selected bitmap box index
End If
End Sub
'Copyright 1995 by Hitoshi Ozawa
Sub ImgBitmaps_DragDrop (Index As Integer, Source As Control, X As Single, Y As Single)
'a new bitmap image was dropped to the bitmaps image box
displayBMP Index             'replace the current bitmap with a new bitmap image
End Sub
'Copyright 1995 by Hitoshi Ozawa
Sub ImgBitmaps_DragOver (Index As Integer, Source As Control, X As Single, Y As Single, state As Integer)
Select Case state
  Case 0
    'change icon when over
    frmGetFile.filFiles.DragIcon = frmGetFile.picFile2
  Case 1
    'change icon to release
    frmGetFile.filFiles.DragIcon = frmGetFile.PicFile1
End Select
End Sub
Sub imgLeft_Click ()
 If MouseButton = 1 Then
  imgLeft.Picture = imgLeft1.Picture
  MouseButton = 0
 Else
  imgRight.Picture = imgRight1.Picture
  imgLeft.Picture = imgLeft2.Picture
  MouseButton = 1
 End If
End Sub
Sub imgRight_Click ()
 If MouseButton = 2 Then
  imgRight.Picture = imgRight1.Picture
  MouseButton = 0
 Else
  imgRight.Picture = imgRight2.Picture
  imgLeft.Picture = imgLeft1.Picture
  MouseButton = 2
 End If
End Sub
Sub imgSave_Click ()
 imgSave.Picture = imgSave2.Picture    'depress save button
 imgSave.Refresh                       'redraw button to show it is depressed
 mnuSave_Click                         'save file
 imgSave.Picture = imgSave1.Picture    'raise save button
End Sub
Sub mnuAbout_Click ()
frmAbout.Show 1      'display the About dialog box - wait until OK is pressed before continuing
End Sub
'Copyright 1995 by Hitoshi Ozawa
Sub mnuAppend_Click ()
'Append a new bitmap image box to then end
'Change the width of the current form so that all bitmap boxes will be displayed
If (picBitmaps(cntBitmaps - 1).Left + picBitmaps(cntBitmaps - 1).Width * 2) > frmMain.Width Then
  frmMain.Width = picBitmaps(cntBitmaps - 1).Left + picBitmaps(cntBitmaps - 1).Width * 2.5
End If
'Add a new element to the picBitmaps array
Load picBitmaps(cntBitmaps)
picBitmaps(cntBitmaps).Top = picBitmaps(0).Top
picBitmaps(cntBitmaps).Left = picBitmaps(cntBitmaps - 1).Left + picBitmaps(cntBitmaps - 1).Width
picBitmaps(cntBitmaps).Picture = LoadPicture()
picBitmaps(cntBitmaps).BorderStyle = 0
picBitmaps(cntBitmaps).Visible = True
'create corresponding imgBitmaps array
Load imgBitmaps(cntBitmaps)
imgBitmaps(cntBitmaps).Top = picBitmaps(cntBitmaps).Top
imgBitmaps(cntBitmaps).Left = picBitmaps(cntBitmaps).Left
imgBitmaps(cntBitmaps).Picture = LoadPicture()
imgBitmaps(cntBitmaps).BorderStyle = 0
imgBitmaps(cntBitmaps).Visible = True
'Create name field
Load txtBitName(cntBitmaps)
txtBitName(cntBitmaps).Top = txtBitName(0).Top
txtBitName(cntBitmaps).Left = picBitmaps(cntBitmaps).Left
txtBitName(cntBitmaps).Text = ""
txtBitName(cntBitmaps).BackColor = RGB(256, 256, 256)
txtBitName(cntBitmaps).Visible = True
'Increase number of bitmaps
cntBitmaps = cntBitmaps + 1
Form_resize
End Sub
'Copyright 1995 by Hitoshi Ozawa
Sub mnuBMPFile_Click ()
Dim retcode As Integer
'Display the frmGetFile as modal
frmGetFile.Show
'If not text file Execute file
Select Case LCase$(Right$(frmGetFile.Tag, 3))
 Case "exe"
   retcode = Shell(frmGetFile.Tag, 1)
 Case "com"
   retcode = Shell(frmGetFile.Tag, 1)
 Case "bat"
   retcode = Shell(frmGetFile.Tag, 1)
 Case "wri"
   retcode = Shell("write.exe " & frmGetFile.Tag, 1)
 Case Else   'if not any of above, treat at text file
  'Get file number
   FileNum = FreeFile
End Select
End Sub
'Copyright 1995 by Hitoshi Ozawa
Sub mnuClear_Click ()
'make sure that element is selected
If selBitmap < 0 Then
  MsgBox ("Please selected an bitmap element")
  Exit Sub
End If
'Clear the selected bitmap
imgBitmaps(selBitmap).Picture = LoadPicture()
picBitmaps(selBitmap).Visible = True
txtBitName(selBitmap).Text = ""
txtBitName(selBitmap).BackColor = RGB(256, 256, 256)
End Sub
'Copyright 1995 by Hitoshi Ozawa
Sub mnuClose_Click ()
'Deselect current file
'Clear text area
frmMain.Caption = ""                        'Clear main form caption
'Refresh frmGetfile
frmGetFile.txtFileName.Text = ""            'Clear file name
frmGetFile.filFiles.Pattern = "*.txt"       'Clear file selection
frmGetFile.filFiles.Refresh                 'Redraw file selection dialog box
End Sub
Sub mnuContents_Click ()
Dim RtnCode As Integer
RtnCode = WinHelp(frmMain.hWnd, HelpFileName, HELP_CONTENTS, 0)
If RtnCode = 0 Then
 MsgBox ("Can not find BITLIN.HLP file.")
End If
End Sub
'Copyright 1995 by Hitoshi Ozawa
Sub mnuCopy_Click ()
'make sure that element is selected
If selBitmap < 0 Then
  MsgBox ("Please selected an bitmap element")
  Exit Sub
End If
'clear border of bitmap to copy to clipboard
imgBitmaps(selBitmap).BorderStyle = 0
picBitmaps(selBitmap).BorderStyle = 0
Clipboard.Clear      'clear clipboard area
Clipboard.SetData imgBitmaps(selBitmap).Picture
'reset border of selected bitmap
imgBitmaps(selBitmap).BorderStyle = 1
picBitmaps(selBitmap).BorderStyle = 1
End Sub
'Copyright 1995 by Hitoshi Ozawa
Sub mnuDelete_Click ()
Dim cnt
'make sure that at least one element is displayed
If cntBitmaps = 0 Then
  MsgBox ("Can not delete the last element")
  Exit Sub
End If
'make sure that element is selected
If selBitmap < 0 Then
  MsgBox ("Please selected an bitmap element")
  Exit Sub
End If
'move back pictures
For cnt = selBitmap To cntBitmaps - 2
  imgBitmaps(cnt).Picture = imgBitmaps(cnt + 1).Picture
  picBitmaps(cnt).Visible = picBitmaps(cnt + 1).Visible
  imgBitmaps(cnt).Visible = imgBitmaps(cnt + 1).Visible
  txtBitName(cnt).Text = txtBitName(cnt + 1).Text        'move forward names
'Clear the last bitmap
Unload imgBitmaps(cntBitmaps - 1)
Unload picBitmaps(cntBitmaps - 1)
Unload txtBitName(cntBitmaps - 1)
cntBitmaps = cntBitmaps - 1
If selBitmap = cntBitmaps Then
  selBitmap = -1
  imgBitmaps(selBitmaps).BorderStyle = 1
  picBitmaps(selBitmaps).BorderStyle = 1
End If
End Sub
'Copyright 1995 by Hitoshi Ozawa
Sub mnuExit_Click ()
Dim RtnCode As Integer
RtnCode = WinHelp(frmMain.hWnd, HelpFileName, HELP_QUIT, 0)
If RtnCode = 0 Then
 MsgBox ("Can not find BITLIN.HLP file.")
End If
End Sub
Sub mnuHowto_Click ()
RtnCode = WinHelp(frmMain.hWnd, HelpFileName, HELP_HELPONHELP, 0)
If RtnCode = 0 Then
 MsgBox ("Can not find BITLIN.HLP file.")
End If
End Sub
'Copyright 1995 by Hitoshi Ozawa
Sub mnuInsert_Click ()
Dim cnt
'make sure that element is selected
If selBitmap < 0 Then
  MsgBox ("Please selected an bitmap element")
  Exit Sub
End If
'append a new element
mnuAppend_Click
'move back pictures
For cnt = cntBitmaps - 1 To selBitmap + 1 Step -1
  imgBitmaps(cnt).Picture = imgBitmaps(cnt - 1).Picture
  picBitmaps(cnt).Visible = picBitmaps(cnt - 1).Visible
  imgBitmaps(cnt).Visible = imgBitmaps(cnt - 1).Visible
  txtBitName(cnt).Text = txtBitName(cnt - 1).Text        'move back names
'Clear the selected bitmap
imgBitmaps(selBitmap).Picture = LoadPicture()
picBitmaps(selBitmap).Visible = True
txtBitName(selBitmap).Text = ""
End Sub
'Copyright 1995 by Hitoshi Ozawa
Sub mnuNew_Click ()
'Clear text area
ODLSample.Clear
frmMain.Caption = ""
For cnt = cntBitmaps - 1 To 1 Step -1
 Unload picBitmaps(cnt)
 Unload imgBitmaps(cnt)
 Unload txtBitName(cnt)
ReDim startp(0 To 1) As Integer
picBitmaps(0).Picture = LoadPicture()
picBitmaps(0).Visible = True
imgBitmaps(0).Picture = LoadPicture()
txtBitName(0).BackColor = RGB(256, 256, 256)
txtBitName(0).Text = ""
selBitmap = -1
cntBitmaps = 1
End Sub
'Copyright 1995 by Hitoshi Ozawa
Sub mnuOpen_Click ()
'Open lined bitmap image file
frmGetFile.cmdOK.Default = True       'set OK button in file selection dialog box as a default selection
frmGetFile.Show 1
frmGetFile.cmdOK.Default = False
If frmGetFile.Tag = "" Then
 Exit Sub
End If
frmMain.Tag = txtHeight.Text
frmOpen.Show 1
mnuNew_Click
For cnt = 0 To frmOpen.Tag - 1
 If cnt > 0 Then
   mnuAppend_Click
 End If
 imgBitmaps(cnt).Picture = frmOpen.picTemp(cnt).Image
 picBitmaps(cnt).Visible = False
 imgBitmaps(cnt).Refresh
 If cnt > 0 Then
  Unload frmOpen.picTemp(cnt)
 End If
End Sub
'Copyright 1995 by Hitoshi Ozawa
Sub mnuPaste_Click ()
'make sure that element is selected
If selBitmap < 0 Then                     'display a error message if not selected
  MsgBox ("Please selected an bitmap element")
  Exit Sub
End If
'Display picture
imgBitmaps(selBitmap).Picture = Clipboard.GetData()      'get image from a clipboard
picBitmaps(selBitmap).Visible = False                    'hide picBitmaps() so imgBitmaps() is displayed
End Sub
'Copyright 1995 by Hitoshi Ozawa
Sub mnuSample_Click ()
'display selected bitmap images with text in ODList
ReDim Preserve startp(0 To cntBitmaps) As Integer   'reset starting position of items
Dim cnt
'clear previous ODList display
ODLSample.Clear
'remove border before if any bitmap is selected copying bitmaps
If selBitmap > -1 Then
 picBitmaps(selBitmap).BorderStyle = 0  'Set border off
 imgBitmaps(selBitmap).BorderStyle = 0  'Set border off
 picBitmaps(selBitmap).Refresh          'redraw picture
 imgBitmaps(selBitmap).Refresh          'redraw image
End If
picTemp.Picture = LoadPicture()          'clear temporary picture area (used to concatenate bitmaps)
picTemp.Width = picBitmaps(0).Width * cntBitmaps   'Set width to total with of bitmaps
picTemp.Height = picBitmaps(0).Height              'set height to be same as bitmaps
                           'copy bitmap image to temporary area
RtnCode = BitBlt(picTemp.hDC, 0, 0, picBitmaps(0).Width * cntBitmaps, picTemp.Height, picBitmaps(0).hDC, 0, 0, SRCCOPY)
picTemp.Refresh                                    'redraw temporary bitmap
                           'place it on top of bitmaps
picTemp.Top = picBitmaps(0).Top + ODLSample.Height + picControl.ScaleHeight + 8
picTemp.Left = picBitmaps(0).Left + 8
'redraw borders if any bitmap is selected
If selBitmap > -1 Then
 picBitmaps(selBitmap).BorderStyle = 1  'redraw borders
 imgBitmaps(selBitmap).BorderStyle = 1  'redraw borders
 picBitmaps(selBitmap).Refresh          'redraw picture
 imgBitmaps(selBitmap).Refresh          'redraw image
End If
'load bitmap image to display
ODLSample.Picture = picTemp.Image       'set bitmap images to concatenated bitmap image
picTemp.Visible = False                 'hide temporary bitmap image
'initialization
ODLSample.BackColor = &HFFFFFF          'make background color white
ODLSample.ItemBackColor = &HFFFFFF      'make bitimage background color white
ODLSample.BitmapDivCnt = cntBitmaps     'define number of images contained in a BMP file
ODLSample.ItemHeight = Val(txtHeight)   'define width of each bitmap image
For cnt = 0 To cntBitmaps - 1
 ODLSample.BitmapIndex = cnt            'set bitmap to use
 ODLSample.StartPosition = startp(cnt)  'set x position of bitmap items
 ODLSample.AddItem txtBitName(cnt)      'add item to the list
End Sub
'Copyright 1995 by Hitoshi Ozawa
Sub mnuSave_Click ()
'Save bitmap image to a file
If fname = "" Then                  'Check if filename is defined - ie. it was saved once
 frmGetFile.Hide                      'if not, then prompt for file name
 frmGetFile.txtFileName.Text = ""
 frmGetFile.Refresh
 frmGetFile.cmdOK.Default = True
 frmGetFile.Show 1
 frmGetFile.cmdOK.Default = False
 If frmGetFile.Tag = "" Then
  Exit Sub
 End If
 fname = frmGetFile.Tag
End If
procSave                           'save bitmap images to a file
End Sub
'Copyright 1995 by Hitoshi Ozawa
Sub mnuSaveAs_Click ()
'save bitmap images with a new name
frmGetFile.Hide                    'hide frmGetFile form to avoid simulatenous opening
frmGetFile.txtFileName.Text = ""   'clear current file name
frmGetFile.Refresh                 'redraw file name entry dialog so file name is cleared
frmGetFile.cmdOK.Default = True    'set OK as a default button
frmGetFile.Show 1                  'display the file entry dialog box
frmGetFile.cmdOK.Default = False   'reset OK button so it is no longer a default
If frmGetFile.Tag = "" Then        'check if file name was entered
  Exit Sub                            'if not, then cancel this routine
End If
fname = frmGetFile.Tag             'set filename to a entered file name
procSave                           'save bitmap image to file
End Sub
Sub mnuSearch_Click ()
'display search help dialog box
RtnCode = WinHelp(frmMain.hWnd, HelpFileName, HELP_PARTIALKEY, 0)
If RtnCode = 0 Then
 MsgBox ("Can not find BITLIN.HLP file.")
End If
End Sub
Sub ODLSample_DblClick (ListIndex%, List$)
'Move selected item to left or to the right
Select Case MouseButton
 Case 1                                   'move double-clicked image to left
  startp(ListIndex%) = startp(ListIndex%) - 10      'move item 10 position to left
  If startp(ListIndex%) < 0 Then          'if going past left of screen then reset to left margin
    startp(ListIndex%) = 0
  End If
 Case 2                                  'move double-clicked image to right
  startp(ListIndex%) = startp(ListIndex%) + 10        'move item 10 position to right
 End Select
mnuSample_Click                           'redraw ODList box
End Sub
'Copyright 1995 by Hitoshi Ozawa
Sub picBitmaps_Click (Index As Integer)
If picBitmaps(Index).BorderStyle = 1 Then
 picBitmaps(Index).BorderStyle = 0
 imgBitmaps(Index).BorderStyle = 0
 txtBitName(Index).BackColor = RGB(256, 256, 256)
 selBitmap = -1
 If selBitmap > -1 Then
  picBitmaps(selBitmap).BorderStyle = 0  'Reset selected bitmap
  imgBitmaps(selBitmap).BorderStyle = 0
  txtBitName(selBitmap).BackColor = RGB(256, 256, 256)
 End If
 picBitmaps(Index).BorderStyle = 1      'Set selected bitmap
 imgBitmaps(Index).BorderStyle = 1
 txtBitName(Index).BackColor = RGB(160, 240, 120)
 selBitmap = Index
End If
End Sub
'Copyright 1995 by Hitoshi Ozawa
Sub picBitmaps_DragDrop (Index As Integer, Source As Control, X As Single, Y As Single)
displayBMP Index
End Sub
'Copyright 1995 by Hitoshi Ozawa
Sub picBitmaps_DragOver (Index As Integer, Source As Control, X As Single, Y As Single, state As Integer)
Select Case state
  Case 0
    'change icon when over
    frmGetFile.filFiles.DragIcon = frmGetFile.picFile2
  Case 1
    'change icon to release
    frmGetFile.filFiles.DragIcon = frmGetFile.PicFile1
End Select
End Sub
'Copyright 1995 by Hitoshi Ozawa
Sub procSave ()
'Save current bitmap image to a file
'remove border before if any bitmap is selected copying bitmaps
If selBitmap > -1 Then
 picBitmaps(selBitmap).BorderStyle = 0  'Set border off
 imgBitmaps(selBitmap).BorderStyle = 0  'Set border off
 picBitmaps(selBitmap).Refresh          'redraw picture
 imgBitmaps(selBitmap).Refresh          'redraw image
End If
picTemp.Picture = LoadPicture()          'clear temporary picture area (used to concatenate bitmaps)
picTemp.Width = picBitmaps(0).Width * cntBitmaps   'Set width to total with of bitmaps
picTemp.Height = picBitmaps(0).Height              'set height to be same as bitmaps
                           'copy bitmap image to temporary area
RtnCode = BitBlt(picTemp.hDC, 0, 0, picBitmaps(0).Width * cntBitmaps, picTemp.Height, picBitmaps(0).hDC, 0, 0, SRCCOPY)
picTemp.Refresh                                    'redraw temporary bitmap
                           'place it on top of bitmaps
picTemp.Top = picBitmaps(0).Top + ODLSample.Height + picControl.ScaleHeight + 8
picTemp.Left = picBitmaps(0).Left + 8
'redraw borders if any bitmap is selected
If selBitmap > -1 Then
 picBitmaps(selBitmap).BorderStyle = 1  'redraw borders
 imgBitmaps(selBitmap).BorderStyle = 1  'redraw borders
 picBitmaps(selBitmap).Refresh          'redraw picture
 imgBitmaps(selBitmap).Refresh          'redraw image
End If
'load bitmap image to display
SavePicture picTemp.Image, fname
picTemp.Visible = False                 'hide temporary bitmap image
'update file form
frmGetFile.filFiles.Refresh
End Sub
Sub txtHeight_KeyPress (KeyAscii As Integer)
If KeyAscii = 13 Then
 txtHeight_LostFocus
End If
End Sub
Sub txtHeight_LostFocus ()
Dim cnt
If txtHeight.Text = "" Then
  txtHeight.Text = 34 * screen.TwipsPerPixelX
End If
'Change size of bitmap display list
For cnt = 0 To cntBitmaps - 1
  picBitmaps(cnt).Width = Val(txtHeight.Text) * screen.TwipsPerPixelX
  picBitmaps(cnt).Height = Val(txtHeight.Text) * screen.TwipsPerPixelY
  picBitmaps(cnt).Left = picBitmaps(0).Left + (Val(txtHeight.Text) * screen.TwipsPerPixelX) * cnt
  imgBitmaps(cnt).Width = picBitmaps(cnt).Width
  imgBitmaps(cnt).Height = picBitmaps(cnt).Height
  imgBitmaps(cnt).Left = picBitmaps(cnt).Left
 'change name field properties
 txtBitName(cnt).Width = picBitmaps(cnt).Width
 txtBitName(cnt).Left = picBitmaps(cnt).Left
Form_resize
End Sub